perm filename TRANS1[1,JMC] blob sn#005275 filedate 1970-08-12 generic text, type T, neo UTF8
00100	(DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
00200	(T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
00300	((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
00400	(SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
00500	(TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
00600	(T (TRANSFORM W R DONE)))) (TRANSA E R)))))
00700	
00800	(DE TRANSA (E R) (COND ((NULL R) E) (T 
00900	((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
01000	(TRANSB E (CAR R))))))
01100	
01200	(DE TRANSB (E RULE) ((LAMBDA (W) (COND ((EQ W (QUOTE NO)) E)
01300	(T (SUBLIS (CADR RULE) W)))) (INST E (CAR RULE) NIL)))
01400	
01500	(DE SIDE (X Y) X)
01600	
01700	(SETQ R1 (QUOTE (
01800	((PLUS X.Y) (PLUSA X (PLUS.Y)))
01900	((PLUSA 0 . X) (PLUSA . X))
02000	((PLUS.NIL) (PLUSB.NIL))
02100	((PLUSA X (PLUSB.Y)) (PLUSB X.Y))
02150	((PLUSA (PLUSB . X)) (PLUSB . X))
02200	)))
02300	
02400	(SETQ R2 (QUOTE (
02500	((PLUS X . Y)  (PLUSA X (PLUS .Y)))
02600	((PLUS . NIL) 0)
02700	((PLUSA 0 . X) (PLUSA . X))
02800	((PLUSA) 0)
02900	((PLUSA X 0) X)
03000	((PLUSA X) X)
03100	((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) .Z))
03200	
03300	((TIMES X . Y) (TIMESA X (TIMES . Y)))
03400	((TIMES) 1)
03500	((TIMESA 1 . X) (TIMESA . X))
03600	((TIMESA) 1)
03700	((TIMESA X 1) X)
03800	((TIMESA X) X)
03900	((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA .Y) .Z))
04000	
04100	((TIMES 0 . X) 0)
04200	((TIMESA 0 . X) 0)
04300	)))
04400